home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / vericard.zip / VERICARD.PAS < prev   
Pascal/Delphi Source File  |  1993-04-19  |  1KB  |  64 lines
  1.  
  2.   {$F+,D+,L+}
  3.  
  4. unit Vericard;
  5.  
  6. interface
  7.  
  8.   function Vc(c : string) : char;
  9.  
  10. implementation
  11.  
  12.   function Vc(c : string) : char;
  13.   var
  14.     card : string[21];
  15.     Vcard : array[0..21] of byte absolute card;
  16.     Xcard : integer;
  17.     Cstr : string[21];
  18.     y, x : integer;
  19.   begin
  20.     x := 0;
  21.     Cstr := '                ';
  22.     Cstr := '';
  23.     fillchar(Vcard, 22, #0);
  24.     card := c;
  25.     for x := 1 to 20 do
  26.       if (Vcard[x] in [48..57]) then
  27.         Cstr := Cstr + chr(Vcard[x]);
  28.     card := '';
  29.     card := Cstr;
  30.     Xcard := 0;
  31.     if NOT odd(length(card)) then
  32.       for x := (length(card) - 1) downto 1 do
  33.         begin
  34.           if odd(x) then
  35.             y := ((Vcard[x] - 48) * 2)
  36.           else
  37.             y := (Vcard[x] - 48);
  38.           if (y >= 10) then
  39.             y := ((y - 10) + 1);
  40.           Xcard := (Xcard + y)
  41.         end
  42.     else
  43.       for x := (length(card) - 1) downto 1 do
  44.         begin
  45.           if odd(x) then
  46.             y := (Vcard[x] - 48)
  47.           else
  48.             y := ((Vcard[x] - 48) * 2);
  49.           if (y >= 10) then
  50.             y := ((y - 10) + 1);
  51.           Xcard := (Xcard + y)
  52.         end;
  53.     x := (10 - (Xcard mod 10));
  54.     if (x = 10) then
  55.       x := 0;
  56.     if (x = (Vcard[length(card)] - 48)) then
  57.       Vc := Cstr[1]
  58.     else
  59.       Vc := #0
  60.   end;
  61.  
  62. END.
  63.  
  64.